Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Pascal/Snippets/Async Sample/Sample.p

Text File | 1995-07-11 | 11.6 KB | 459 lines | [TEXT/CWIE]

Program Test;
{---------------------------------------------------------------------------
*
*  This is a sample program which demonstrates async sound.  In this example,
*  three channels are used.  Also added in (per request) is a loop which plays 4
*  sounds (4 parts of a theme), in order, continuously in one of the channels.
*
*  NOTE: The sound routines are rough and probably can be polished a bit.
*  Because I am just learning them and taking samples from here and there,
*  there may be useless things/record items declared.  I'll clean all that
*  up when I get the chance.
*
*  This project uses universal proc pointers, so it can be compiled in either
*  68k mode or PPC mode.  (I also had to make the SndCommand argument a VAR
*  parameter in PlayAsyncCallback to get it to run native).  It works great in
*  CodeWarrior.  If you want to get the 68K version running successfully using
*  the Think Pascal compiler, you'll have to take out the UPP stuff and replace
*  them with the standard procedure pointers.  You'll also have to remove the
*  toolbox initialization, and probably some of the USES files.
*
*  A window is also setup for displaying what the sound manager is doing during
*  certain parts of execution.
*
*  Memory:  For this sample, I'm using some rather large sounds, so it is memory
*  intensive.  For 68K, I allocate 2Meg, and for PPC, I allocate 3Meg.  Also,
*  since I utilize the application resource to retrieve the sound (rather than
*  an external sound file which would have been better), you have to pump up the
*  memory for CodeWarrior to successfully link in the sound resources.
*
*  If you have any questions, feel free to contact me at [e-mail].  I'll
*  do my best to answer your questions.
*
*  Regards,
*  Bill Catambay
---------------------------------------------------------------------------}


Uses
  Fonts, Types, Segload, Windows, Dialogs, ToolUtils, Resources, QDOffscreen,
  Sound, OSUtils, GestaltEqu;

Const
    max_chan = 4;

Var
    err: OSerr;
    chan: integer;
    inplay: array[1..max_chan] of boolean;
    the_house: pichandle;
    pics: array[1..3] of pichandle;
    ic:    array[1..8] of pichandle;
    i: integer;
    sndwindow: windowPtr;
    picture: windowPtr;
    say_active: boolean;
    cur_line: integer;
    cur_col: integer;
    use_size: integer;
    font_num: integer;
    theme_song: array[1..4] of handle;
    theme_playing: integer;
    theme_chan: integer;
    outwindow: windowPtr;
    offscreen:    gworldPtr;

    {--  SOUND STUFF  --}
Const
    kResourceSoundComplete = 1;
    kHandleSoundComplete = 2;
    AsyncSoundMaxChannels = 4;

Type
    ASndQEl = record
        qLink: QElemPtr;
        qType: Integer;
        aQPlaying: Boolean;
        aQCompletionCode: Integer;
        aQSoundHandle: Handle;
        end;
    ASndQElPtr = ^ASndQEl;
    SoundArrayElt = record
        initMode: Longint;
        soundMgrChannel: SndChannelPtr;
        completionQueue: QHdr;
        end;
    SoundArrayHdr = Integer;
    SoundArray = record
        count: SoundArrayHdr;
        channels: array[1..4] of SoundArrayElt;
        end;
    SoundArrayPtr = ^SoundArray;
    SoundArrayHdl = ^SoundArrayPtr;

Var
    theAsyncChannels: SoundArrayHdl;

Function AsyncSoundInit (numberOfChannels: Integer): OSErr;

Procedure Check (result: Integer);

    begin
    AsyncSoundInit := result;
    if result <> noErr then
        begin
        theAsyncChannels := nil;
        Exit(AsyncSoundInit);
        end;
    end;

Var
    gestaltResult: Longint;
    i: Integer;

    begin
    Check(Gestalt(gestaltSoundAttr, gestaltResult));
    if (numberOfChannels <= 0) or (numberOfChannels > AsyncSoundMaxChannels) then
        Check(paramErr);
    theAsyncChannels := SoundArrayHdl(NewHandleClear(SIZEOF(SoundArrayHdr) +
        SIZEOF(SoundArrayElt) * numberOfChannels));
    if theAsyncChannels <> nil then
        with theAsyncChannels^^ do
            begin
            count := numberOfChannels;
            for i := 1 to count do
                channels[i].initMode := initMono;
            end;
    Check(MemError);
    end;

Procedure PopQueue (whichChannel: Integer);

Var
    poppedQElem: Ptr;
    myErr: OSErr;

    begin
    with theAsyncChannels^^.channels[whichChannel], completionQueue do
        begin
        poppedQElem := Ptr(qHead);
        myErr := Dequeue(qHead, @completionQueue);
        DisposePtr(poppedQElem);
        end;
    end;

Procedure AsyncSoundIdle;

Var
    whichChannel: Integer;
    firstQElt: aSndQElPtr;
    myErr: OSErr;

    begin
    if theAsyncChannels <> nil then
        begin
        HLock(Handle(theAsyncChannels));
        with theAsyncChannels^^ do
            for whichChannel := 1 to count do
                with channels[whichChannel] do
                    begin
                    if completionQueue.qHead <> nil then
                        repeat
                            firstQElt := aSndQElPtr(completionQueue.qHead);
                            with firstQElt^ do
                                if not aQPlaying then
                                    begin
                                    if aQCompletionCode = kResourceSoundComplete then
                                        DisposeHandle(aQSoundHandle);
                                    PopQueue(whichChannel);
                                    end;
                        until (completionQueue.qHead = nil) | firstQElt^.aQPlaying;
                    if completionQueue.qHead = nil then
                        begin
                        myErr := SndDisposeChannel(soundMgrChannel, True);
                        soundMgrChannel := nil;
                        end;
                    end;
        HUnlock(Handle(theAsyncChannels));
        end;
    end;

Function FindFreeAsyncSoundChannel: Integer;

Var
    whichChannel: Integer;

    begin
    FindFreeAsyncSoundChannel := 0;
    if theAsyncChannels <> nil then
        with theAsyncChannels^^ do
            for whichChannel := 1 to count do
                with channels[whichChannel], completionQueue do
                    if qHead = nil then
                        begin
                        FindFreeAsyncSoundChannel := whichChannel;
                        Leave;
                        end;
    end;

Procedure PlayAsyncCallback (chan: SndChannelPtr; Var cmd: SndCommand);

    begin
    case cmd.param1 of
        kResourceSoundComplete,
        kHandleSoundComplete:    ASndQElPtr(cmd.param2)^.aQPlaying := False;
        otherwise                ;
    {CASE}    end;
    end;

Function PlayAsyncSound (soundHandle: Handle;
                         whichChannel: Integer;
                         completionCode: Integer): OSErr;

Procedure Check (result: OSErr);

    begin
    PlayAsyncSound := result;
    if result <> noErr then
        Exit(PlayAsyncSound);
    end;

Var
    mySndChan: SndChannelPtr;
    mySndCmd: SndCommand;
    sndUPP: SndCallBackUPP;

    begin
    if (whichChannel <= 0) or (whichChannel > theAsyncChannels^^.count) then
        Check(paramErr);
    HLock(Handle(theAsyncChannels));
    with theAsyncChannels^^.channels[whichChannel] do
        if completionQueue.qHead = nil then
            begin
            mySndChan := nil;
            sndUPP := NewSndCallBackProc(@PlayAsyncCallback);
            Check(SndNewChannel(mySndChan, sampledSynth, initMode, sndUPP));
            end
        else
            mySndChan := soundMgrChannel;
    Check(SndPlay(mySndChan, SndListHandle(soundHandle), True));
    with mySndCmd do
        begin
        cmd := callBackCmd;
        param1 := completionCode;
        param2 := Longint(NewPtr(SIZEOF(ASndQEl)));
        with ASndQElPtr(param2)^ do
            begin
            aQPlaying := True;
            aQCompletionCode := completionCode;
            aQSoundHandle := soundHandle;
            end;
        with theAsyncChannels^^.channels[whichChannel] do
            begin
            soundMgrChannel := mySndChan;
            Enqueue(QElemPtr(param2), @completionQueue);
            end;
        end;
    Check(SndDoCommand(mySndChan, mySndCmd, False));
    end;

Function PlayAsyncSoundResource (soundID: Integer;
                                 whichChannel: Integer): OSErr;

Var
    soundHandle: Handle;

    begin
    if theAsyncChannels <> nil then
        begin
        soundHandle := GetResource('snd ', soundID);
        if soundHandle <> nil then
            begin
            DetachResource(soundHandle);
            PlayAsyncSoundResource := PlayAsyncSound(soundHandle, whichChannel,
                kResourceSoundComplete);
            end
        else
            PlayAsyncSoundResource := ResError;
        end
    else
        begin  { not really sure what to do in this case }
        PlayAsyncSoundResource := noErr;
        end;
    end;

Function AsyncSoundChannelActive (whichChannel: Integer): Boolean;

    begin
    if theAsyncChannels <> nil then
        begin
        if (whichChannel > 0) and (whichChannel <= theAsyncChannels^^.count) then
            AsyncSoundChannelActive :=
                theAsyncChannels^^.channels[whichChannel].completionQueue.qHead <> nil
        else
            AsyncSoundChannelActive := False;
        end
    else
        AsyncSoundChannelActive := False;
    end;

Procedure say(txt:    str255);

    begin
    if not say_active then
        exit(say);
    setport(outwindow);
    selectwindow(outwindow);
    use_size := 9;
    textsize(use_size);
    textfont(font_num);
    cur_line := cur_line + use_size + 2;
    if cur_line > 1000 then
        begin
        cur_line := 1;
        cur_col := cur_col + use_size*40;
        if cur_col > 1000 then
            cur_col := 10;
        end;
    if cur_line > outwindow^.portRect.bottom then
        begin
        EraseRect(outwindow^.portRect);
        cur_line := 2 + use_size;
        end;
    MoveTo(cur_col,cur_line);
    drawstring(txt);
    setport(FrontWindow);
    end; { of say }

Procedure Initialize_debug;

Var
    outrect:    rect;

    begin
    getfnum('Monaco',font_num);
    outrect.top := 60;
    outrect.left := 10;
    outrect.right := outrect.left + 400;
    outrect.bottom := outrect.top + 400;
    outwindow := NewCwindow(NIL, outrect, 'Output Window', TRUE, documentProc,
        Pointer(-1),TRUE,0);
    cur_line := 10;
    cur_col := 10;
    end;

Function num2str(num:    integer): string;

Var
    dig:        integer;
    str,sign:    str255;

    begin
    numTostring(num,str);
    num2str := str;
    end; { of num2str }

Procedure Toolbox_init;

    begin
    say_active := TRUE;
    initGraf(@qd.thePort);
    initFonts;
    initWindows;
    initMenus;
    TEinit;
    initDialogs(nil);
    MaxApplZone;
    InitCursor;
    end;

Procedure Play_theme;

var
    next_theme:    integer;
    err: OSerr;

    begin
    if theme_playing = 0 then
        begin
        say('Initializing theme...');
        theme_playing := 1;
        theme_chan := FindFreeAsyncSoundChannel;
        theme_song[1] := GetResource('snd ',151);
        next_theme := 2;
        end
    else
        begin
        disposeHandle(theme_song[theme_playing]);
        theme_playing := theme_playing + 1;
        if theme_playing > 4 then
            theme_playing := 1;
        next_theme := theme_playing + 1;
        if next_theme > 4 then
            next_theme := 1;
        end;
    say(concat('Playing part ',num2str(theme_playing),' of theme...'));
    DetachResource(theme_song[theme_playing]);
    err := PlayAsyncSound(theme_song[theme_playing], theme_chan,
        kResourceSoundComplete);
    say(concat('Play theme status: ',num2str(err)));
    theme_song[next_theme] := GetResource('snd ',150 + next_theme);
    end;

begin
toolbox_init;
if say_active then
    initialize_debug;
say('Setting up sound...');
err := AsyncSoundInit(max_chan);
say(concat('Initializing status: ',num2str(err)));
chan := FindFreeAsyncSoundChannel;
say(concat('Found free channel ',num2str(chan),' for resource 131'));
err := PlayAsyncSoundResource (131, chan);
say(concat('Got resource 131 status: ',num2str(err)));
chan := FindFreeAsyncSoundChannel;
say(concat('Found free channel ',num2str(chan),' for resource 132'));
err := PlayAsyncSoundResource (132, chan);
say(concat('Got resource 132 status: ',num2str(err)));
for i := 1 to max_chan do
    inplay[i] := false;
{----------------------------------------------------------------}
{  Loop until all sound is completed, or until button is pressed }
{----------------------------------------------------------------}
repeat
    AsyncSoundIdle;
    for i := 1 to max_chan do
        if AsyncSoundChannelActive(i) and (not inplay[i]) then
            begin
            inplay[i] := true;
            say(concat('Playing channel ',num2str(i)));
            end
        else if (not AsyncSoundChannelActive(i)) and inplay[i] then
            begin
            inplay[i] := false;
            say(concat('Done with channel ',num2str(i)));
            end;
    if not AsyncSoundChannelActive(theme_chan) then
        begin
        say('Calling Play_theme procedure...');
        play_theme;
        end;
    {----------------------------------------------------------------}
    { NOTE: Code below is meant to exit loop when all sound is done. }
    { However, since above code was added, sound will never end; so  }
    { loop is only exited upon pressing the mouse button.            }
    {----------------------------------------------------------------}
    for i := 1 to max_chan do
        if AsyncSoundChannelActive(i) then
            leave;  { found active channel -> exit for loop }
    if i > Max_chan then
        begin
        say('Finished!');
        leave;  { all channels done -> exit repeat loop }
        end;
until button;
repeat until not button;
say('Press mouse button');
repeat until button;
end.